home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Except / HVDumpExceptToFile.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-09-05  |  2.3 KB  |  89 lines
  1. unit HVDumpExceptToFile;
  2.  
  3. interface
  4.  
  5. implementation
  6.  
  7. uses
  8.   HVEST,
  9.   HVYAST32,
  10.   Windows,
  11.   SysUtils,
  12.   Forms,
  13.   LiPrgInt;
  14.  
  15. type
  16.   TAppExceptionHandler = class(TObject)
  17.   private
  18.     procedure AppException(Sender: TObject; E: Exception);
  19.   end;
  20.  
  21. function StackDumpStr: string;
  22. var
  23.   i: integer;
  24.   LocInfo: TLocInfo;
  25. begin
  26.   Result := '';
  27.   if not RTLIAvailable then
  28.     Result := '(NO RTLI AVAILABLE!)'#13#10;
  29.  
  30.   if ESTRaw
  31.   then Result := Result + 'Stack trace (raw):'#13#10
  32.   else Result := Result + 'Stack trace:'#13#10;
  33.  
  34.   Result := Result + 'Physical Logical  Unit                (######) Routine';
  35.   for i := 0 to StackDumpCount-1 do
  36.     with StackDump[i] do
  37.     begin
  38.       GetLocationInfo(Pointer(CallerAdr), LocInfo);
  39.       if LocInfo.liLineNo <> 0 then
  40.         Result := Format('%s'#13#10'%.8x %.8x %20s (%5d) %s.%s',
  41.           [Result, DWORD(CallerAdr), PhysicalToLogical(DWORD(CallerAdr)),
  42.             LocInfo.liFileName, LocInfo.liLineNo, LocInfo.liUnitName, LocInfo.liPubSym1Name])
  43.       else
  44.         Result := Format('%s'#13#10'%.8x %.8x %s.%s',
  45.           [Result, DWORD(CallerAdr), PhysicalToLogical(DWORD(CallerAdr)),
  46.             LocInfo.liUnitName, LocInfo.liPubSym1Name]);
  47.     end;
  48. end;
  49.  
  50. procedure TAppExceptionHandler.AppException(Sender: TObject; E: Exception);
  51. var
  52.   F: System.Text;
  53.   LogFileName: string;
  54. begin
  55.   {$I-} { Make sure we don't raise any EInOutError exceptions in here... }
  56.   LogFileName := SysUtils.ChangeFileExt(System.ParamStr(0), '.EST');
  57.   System.Assign(F, LogFileName);
  58.   System.Append(F);
  59.   if IOResult <> 0 then
  60.     System.Rewrite(F);
  61.   try
  62.     System.Writeln(F);
  63.     System.Writeln(F, DateTimeToStr(Now));
  64.     System.Writeln(F, 'Exception: ', E.ClassName);
  65.     System.Writeln(F, 'In ', ParamStr(0));
  66.     System.Writeln(F, E.Message);
  67.     System.Writeln(F, StackDumpStr);
  68.     if IOResult <> 0 then ;
  69.   finally
  70.     System.Close(F);
  71.     if IOResult <> 0 then ;
  72.   end;
  73.   E.Message := E.Message + #10#13'The exception has been logged in '+LogFileName;
  74.   Application.ShowException(E);
  75. end;
  76.  
  77. var
  78.   AppExceptionHandler : TAppExceptionHandler;
  79.  
  80. initialization
  81.   AppExceptionHandler := TAppExceptionHandler.Create;
  82.   Application.OnException := AppExceptionHandler.AppException;
  83.  
  84. finalization
  85.   AppExceptionHandler.Free;
  86.   AppExceptionHandler := nil;
  87.  
  88. end.
  89.